home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH9 / SRC / SHOWAPF.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-05-02  |  10.8 KB  |  377 lines

  1. VERSION 4.00
  2. Begin VB.Form ShowApfForm 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Show APF"
  6.    ClientHeight    =   6060
  7.    ClientLeft      =   1410
  8.    ClientTop       =   630
  9.    ClientWidth     =   6015
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   6750
  21.    KeyPreview      =   -1  'True
  22.    Left            =   1350
  23.    LinkTopic       =   "Form1"
  24.    ScaleHeight     =   6060
  25.    ScaleWidth      =   6015
  26.    Top             =   0
  27.    Width           =   6135
  28.    Begin VB.TextBox YmaxText 
  29.       Height          =   285
  30.       Left            =   5160
  31.       TabIndex        =   13
  32.       Text            =   "7"
  33.       Top             =   5760
  34.       Width           =   855
  35.    End
  36.    Begin VB.TextBox YminText 
  37.       Height          =   285
  38.       Left            =   3600
  39.       TabIndex        =   11
  40.       Text            =   "-7"
  41.       Top             =   5760
  42.       Width           =   855
  43.    End
  44.    Begin VB.TextBox XmaxText 
  45.       Height          =   285
  46.       Left            =   2040
  47.       TabIndex        =   9
  48.       Text            =   "7"
  49.       Top             =   5760
  50.       Width           =   855
  51.    End
  52.    Begin VB.TextBox XminText 
  53.       Height          =   285
  54.       Left            =   480
  55.       TabIndex        =   7
  56.       Text            =   "-7"
  57.       Top             =   5760
  58.       Width           =   855
  59.    End
  60.    Begin VB.TextBox PhiText 
  61.       Height          =   285
  62.       Left            =   3600
  63.       TabIndex        =   6
  64.       Text            =   "0.1570"
  65.       Top             =   5400
  66.       Width           =   855
  67.    End
  68.    Begin VB.TextBox ThetaText 
  69.       Height          =   285
  70.       Left            =   2040
  71.       TabIndex        =   4
  72.       Text            =   "0.6283"
  73.       Top             =   5400
  74.       Width           =   855
  75.    End
  76.    Begin VB.TextBox RText 
  77.       Height          =   285
  78.       Left            =   480
  79.       TabIndex        =   2
  80.       Text            =   "10"
  81.       Top             =   5400
  82.       Width           =   855
  83.    End
  84.    Begin VB.PictureBox Pict 
  85.       AutoRedraw      =   -1  'True
  86.       Height          =   5295
  87.       Left            =   0
  88.       ScaleHeight     =   -14
  89.       ScaleLeft       =   -7
  90.       ScaleMode       =   0  'User
  91.       ScaleTop        =   7
  92.       ScaleWidth      =   15.926
  93.       TabIndex        =   0
  94.       Top             =   0
  95.       Width           =   6015
  96.    End
  97.    Begin VB.Label Label1 
  98.       Caption         =   "Ymax"
  99.       Height          =   255
  100.       Index           =   6
  101.       Left            =   4680
  102.       TabIndex        =   14
  103.       Top             =   5760
  104.       Width           =   495
  105.    End
  106.    Begin VB.Label Label1 
  107.       Caption         =   "Ymin"
  108.       Height          =   255
  109.       Index           =   5
  110.       Left            =   3120
  111.       TabIndex        =   12
  112.       Top             =   5760
  113.       Width           =   495
  114.    End
  115.    Begin VB.Label Label1 
  116.       Caption         =   "Xmax"
  117.       Height          =   255
  118.       Index           =   4
  119.       Left            =   1560
  120.       TabIndex        =   10
  121.       Top             =   5760
  122.       Width           =   495
  123.    End
  124.    Begin VB.Label Label1 
  125.       Caption         =   "Xmin"
  126.       Height          =   255
  127.       Index           =   3
  128.       Left            =   0
  129.       TabIndex        =   8
  130.       Top             =   5760
  131.       Width           =   495
  132.    End
  133.    Begin MSComDlg.CommonDialog LoadDialog 
  134.       Left            =   4680
  135.       Top             =   5280
  136.       _version        =   65536
  137.       _extentx        =   847
  138.       _extenty        =   847
  139.       _stockprops     =   0
  140.       cancelerror     =   -1  'True
  141.    End
  142.    Begin VB.Label Label1 
  143.       Caption         =   "Phi"
  144.       Height          =   255
  145.       Index           =   2
  146.       Left            =   3240
  147.       TabIndex        =   5
  148.       Top             =   5400
  149.       Width           =   375
  150.    End
  151.    Begin VB.Label Label1 
  152.       Caption         =   "Theta"
  153.       Height          =   255
  154.       Index           =   1
  155.       Left            =   1440
  156.       TabIndex        =   3
  157.       Top             =   5400
  158.       Width           =   495
  159.    End
  160.    Begin VB.Label Label1 
  161.       Caption         =   "R"
  162.       Height          =   255
  163.       Index           =   0
  164.       Left            =   240
  165.       TabIndex        =   1
  166.       Top             =   5400
  167.       Width           =   255
  168.    End
  169.    Begin VB.Menu mnuFile 
  170.       Caption         =   "&File"
  171.       Begin VB.Menu mnuFileLoad 
  172.          Caption         =   "&Load..."
  173.          Shortcut        =   ^L
  174.       End
  175.       Begin VB.Menu mnuFileSep 
  176.          Caption         =   "-"
  177.       End
  178.       Begin VB.Menu mnuFileExit 
  179.          Caption         =   "E&xit"
  180.       End
  181.    End
  182. Attribute VB_Name = "ShowApfForm"
  183. Attribute VB_Creatable = False
  184. Attribute VB_Exposed = False
  185. Option Explicit
  186. ' Location of viewing eye.
  187. Dim EyeR As Single
  188. Dim EyeTheta As Single
  189. Dim EyePhi As Single
  190. Const Dtheta = PI / 20
  191. Const Dphi = PI / 20
  192. Const Dr = 1
  193. ' Location of focus point.
  194. Const FocusX = 0#
  195. Const FocusY = 0#
  196. Const FocusZ = 0#
  197. Dim Projector(1 To 4, 1 To 4) As Single
  198. Dim ThePicture As ObjPicture
  199. Dim ShowingParameters As Boolean
  200. ' *******************************************************
  201. ' Rotate the points in the cube and draw the cube.
  202. ' *******************************************************
  203. Private Sub DrawData(pic As Object)
  204.     ' Prevent overflow errors when drawing lines
  205.     ' too far out of bounds.
  206.     On Error Resume Next
  207.     ' Transform the points.
  208.     ThePicture.ApplyFull Projector
  209.     ' Display the data.
  210.     pic.Cls
  211.     ThePicture.Draw pic, EyeR
  212.     pic.Refresh
  213.     ' Display the viewnig parameters.
  214.     ShowViewingParameters
  215. End Sub
  216. Sub ResetViewport()
  217. Dim xmin As Single
  218. Dim xmax As Single
  219. Dim ymin As Single
  220. Dim ymax As Single
  221.     xmin = CSng(XminText.Text)
  222.     xmax = CSng(XmaxText.Text)
  223.     ymin = CSng(YminText.Text)
  224.     ymax = CSng(YmaxText.Text)
  225.     Pict.ScaleLeft = xmin
  226.     Pict.ScaleWidth = xmax - xmin
  227.     Pict.ScaleTop = ymax
  228.     Pict.ScaleHeight = ymin - ymax
  229. Debug.Print Pict.ScaleLeft; Pict.ScaleWidth; Pict.ScaleTop; Pict.ScaleHeight
  230.     DrawData Pict
  231. End Sub
  232. Sub ShowViewingParameters()
  233.     ShowingParameters = True
  234.     RText.Text = Format$(EyeR, "0.0000")
  235.     ThetaText.Text = Format$(EyeTheta, "0.0000")
  236.     PhiText.Text = Format$(EyePhi, "0.0000")
  237.     RText.Refresh
  238.     ThetaText.Refresh
  239.     PhiText.Refresh
  240.     ShowingParameters = False
  241. End Sub
  242. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  243.     Select Case KeyCode
  244.         Case vbKeyLeft
  245.             EyeTheta = EyeTheta - Dtheta
  246.         
  247.         Case vbKeyRight
  248.             EyeTheta = EyeTheta + Dtheta
  249.         
  250.         Case vbKeyUp
  251.             EyePhi = EyePhi - Dphi
  252.         
  253.         Case vbKeyDown
  254.             EyePhi = EyePhi + Dphi
  255.                 
  256.         Case Else
  257.             Exit Sub
  258.     End Select
  259.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  260.     DrawData Pict
  261. End Sub
  262. Private Sub Form_KeyPress(KeyAscii As Integer)
  263.     Select Case KeyAscii
  264.         Case Asc("+")
  265.             EyeR = EyeR + Dr
  266.         
  267.         Case Asc("-")
  268.             EyeR = EyeR - Dr
  269.         
  270.         Case Else
  271.             Exit Sub
  272.     End Select
  273.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  274.     DrawData Pict
  275. End Sub
  276. Private Sub Form_Load()
  277.     ' Initialize the eye position.
  278.     EyeR = 10
  279.     EyeTheta = PI * 0.2
  280.     EyePhi = PI * 0.05
  281.     ' Initialize the projection transformation.
  282.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  283.     ' Create the data.
  284.     CreateData
  285.     ' Project and draw the data.
  286.     DrawData Pict
  287. End Sub
  288. Sub CreateData()
  289. Dim pline As ObjPolyline
  290.     Set ThePicture = New ObjPicture
  291.     Set pline = New ObjPolyline
  292.     ThePicture.objects.Add pline
  293.     pline.AddSegment 0, 0, 0, 5, 0, 0
  294.     pline.AddSegment 0, 0, 0, 0, 5, 0
  295.     pline.AddSegment 0, 0, 0, 0, 0, 5
  296. End Sub
  297. Private Sub mnuFileExit_Click()
  298.     Unload Me
  299. End Sub
  300. Private Sub mnuFileLoad_Click()
  301. Dim fname As String
  302. Dim filenum As Integer
  303. Dim txt As String
  304. Dim xmin As Single
  305. Dim ymin As Single
  306. Dim xmax As Single
  307. Dim ymax As Single
  308.     ' Allow the user to pick a file.
  309.     On Error Resume Next
  310.     LoadDialog.filename = "*.APF"
  311.     LoadDialog.ShowOpen
  312.     If Err.Number = cdlCancel Then
  313.         Unload LoadDialog
  314.         Exit Sub
  315.     ElseIf Err.Number <> 0 Then
  316.         Unload LoadDialog
  317.         Beep
  318.         MsgBox "Error selecting file.", , vbExclamation
  319.         Exit Sub
  320.     End If
  321.     On Error GoTo 0
  322.     fname = LoadDialog.filename
  323.     LoadDialog.InitDir = Left$(fname, Len(fname) _
  324.         - Len(LoadDialog.FileTitle) - 1)
  325.     ' Clear the picture.
  326.     Set ThePicture = Nothing
  327.     ' Open the file.
  328.     filenum = FreeFile
  329.     Open fname For Input As #filenum
  330.     ' Make sure it's an Object Picture File.
  331.     Input #filenum, txt
  332.     If txt <> "3D APF PICTURE" Then
  333.         Close filenum
  334.         Beep
  335.         MsgBox "Error reading file """ & fname & """.", , vbExclamation
  336.         Exit Sub
  337.     End If
  338.     ' Read the picture.
  339.     Set ThePicture = New ObjPicture
  340.     ThePicture.FileInput filenum
  341.     ' Close the file.
  342.     Close filenum
  343.     ' Refresh the display.
  344.     DrawData Pict
  345.     Caption = "Show APF [" & LoadDialog.FileTitle & "]"
  346. End Sub
  347. Private Sub PhiText_Change()
  348.     If ShowingParameters Then Exit Sub
  349.     EyePhi = CSng(PhiText.Text)
  350.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  351.     DrawData Pict
  352. End Sub
  353. Private Sub RText_Change()
  354.     If ShowingParameters Then Exit Sub
  355.     EyeR = CSng(RText.Text)
  356.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  357.     DrawData Pict
  358. End Sub
  359. Private Sub ThetaText_Change()
  360.     If ShowingParameters Then Exit Sub
  361.     EyeTheta = CSng(ThetaText.Text)
  362.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  363.     DrawData Pict
  364. End Sub
  365. Private Sub XmaxText_Change()
  366.     ResetViewport
  367. End Sub
  368. Private Sub XminText_Change()
  369.     ResetViewport
  370. End Sub
  371. Private Sub YmaxText_Change()
  372.     ResetViewport
  373. End Sub
  374. Private Sub YminText_Change()
  375.     ResetViewport
  376. End Sub
  377.